(**************************************************************************)
(*    Kitty escape game                                                   *)
(*                                                                        *)
(*    ELTE-IK                                                             *)
(*                                                                        *)
(**************************************************************************)

(* $Id: escape.ml 1347 2012-06-09 21:00:00Z bkil $ *)

(*
compile:

ocaml -I +lablgtk2 -I +unix lablgtk.cma gtkInit.cmo unix.cma escape.ml

*)

open StdLabels
open List

(* The game logic *)

type color = [`none|`white|`black]

module type BoardSpec = sig
  type t
  val size : int
  val get : t -> x:int -> y:int -> color
  val set : t -> x:int -> y:int -> color:color -> unit
end

(*
The table indexing by columns (x) and rows (y) is the following:
0  0 1 2 3
1   0 1 2 3
2  0 1 2 3
3   0 1 2 3
*)

module Board (Spec : BoardSpec) = struct
  open Spec
  let size = size
  let on_board x y =
    x >= 0 && x < size && y >= 0 && y < size

  let add_pillow board ~x ~y =
    if get board x y = `none then begin
      set board ~x ~y ~color:`white;
      true
    end else false

  let neighbors dir (x,y) =
    let shift = y mod 2 in
    let offsets = [(-1,0); (1,0); (shift-1,-1); (shift,-1); (shift-1,1); (shift,1)] in
    map (fun (dx,dy) -> (dir,(x+dx,y+dy))) offsets

  let rec wide tab queue =
    match queue with
     | [] -> []
     | (dir,(hx,hy))::tl ->
      let dir2 = match dir with | [] -> [(hx,hy)] | _ -> dir in
      if on_board hx hy then
        if tab.(hx).(hy) then begin
          tab.(hx).(hy) <- false;
          let queue2 = List.append tl (neighbors dir2 (hx,hy)) in
          wide tab queue2
        end
        else
          wide tab tl
      else
        dir2

  let kitty board kx ky =
    let tab = Array.init size ~f:(fun i -> Array.init size ~f:(fun j -> get board ~x:i ~y:j <> `white)) in
    wide tab (neighbors [] (kx,ky))

  let move board kx ky tx ty =
    set board ~x:kx ~y:ky ~color:`none;
    if on_board tx ty then
      set board ~x:tx ~y:ty ~color:`black

end

(* GUI *)

open GMain

(* Toplevel window *)

let window = GWindow.window ~title:"Kitten escape" ()

(* Create pixmaps *)

let kitten = [|
(* width height num_colors chars_per_pixel *)
"60 40 5 1";
(* colors *)
"0	c #000000";
"1	c #E7E7E7";
"2	c #717171";
"3	c #383838";
" 	c None";
(* pixels *)
"330                00                                       ";
"0330             0320                                       ";
"333330          023330                                      ";
"3333333         233320                                      ";
" 3333330       0303230                                      ";
" 333000333333333332330                                      ";
" 023030033333330333320                                      ";
"  33000333333003333330                                      ";
"  02033033000300333330                                      ";
"  033030300300030303313                                     ";
"  020300303030300030211000                                  ";
"  0203033303000303001112233000                              ";
"  0333032330303000022121333333300                           ";
"  023302133033030302112230030333330                         ";
"  0330321003033000321222330303003030                        ";
"  02333122033300303122223030300303033                       ";
"   333212203300303221233030030300030030                     ";
"   3222122330000222122330003030303030330                    ";
"    2111221232222222122003030030003030030                   ";
"    01121212222222212222303003003300030330                  ";
"    022222222222222212123300303000303003020                 ";
"     322222121222212222122030003300300300020           000  ";
"      32221212222222121212230300030030030333          02330 ";
"         221222222222221212000030303030303020        0203330";
"          21221221221222222333003030003003003        0333333";
"         321222222222212122300030303303030033          33333";
"        02122222232221222220003030303030030030         03333";
"        21121222    22212233030303333333303003      03333030";
"       31122222    31222222232332322122133003033233333303033";
"      01122223     22212222222222221111223000303003030030300";
"      2122122     021222122222212112121122000030030030300333";
"  0033111223     321212220332222212212121230300303030003300 ";
" 0211112223      02122222    322222222222220003000033230    ";
" 212112123       32121220     332122121223303033333300      ";
"0111111220      00221222    02222222222230030 003           ";
"021222220      222112220   022122122122233330               ";
" 0222230      011212122    02122122122122303                ";
"  0233        222121220    01221222222223330                ";
"              02122220      321232232330                    ";
"                0223        33030                           " |]


let pillow = [|
(* width height num_colors chars_per_pixel *)
"60 40 5 1";
(* colors *)
" 	c None";
"1	c #FBFFFF";
"2	c #75797D";
"3	c #B6BAC3";
"4	c #9A9A9A";
(* pixels *)
"                                                            ";
"                                                            ";
"                 111                                        ";
"                133111                                      ";
"                1313131111                                  ";
"               131131113111111                              ";
"              1313313131131111111                           ";
"             113131131131131313111111                       ";
"            13333131313113111113113111111                   ";
"            11313131313131131311311131111111    1           ";
"           1333131313131313131131131113111111111111  1      ";
"          1331331331313131311311311113111311311111111111    ";
"         13333133133131313131131131311131113113113111131    ";
"        133131331331313131131313131131311311111311111341    ";
"       1133333313313313131313113113111131131311113133343    ";
"       3313131331331331331313131131313113111111311113241    ";
"      13333333313333133131313131313131311313131113134231    ";
"     13333333133331331313131313131311311313111311313231     ";
"     13443333333333333331331313131313131131313113134411     ";
"    13334433333333313313313133131313131313113111113441      ";
"  1333344444434333343333333131333131313131311313314431      ";
"  134334444434434343333331333313133133131313131113441       ";
"  134224444444443434434343333333131331313131311313431       ";
"  113222224444444444343434333333333131331313113113431       ";
"   1134422222444443444434343333333333131313133131431        ";
"    111334422222444444444443443333333333331331313241        ";
"       111334422222444444444434433333331333131333231        ";
"          111133444222444444444444443334313333132311        ";
"             11113334422444444444434443343313133431         ";
"                 1111334222224444444444443333134411         ";
"                    111133442222444444444433133331          ";
"                       111133442222244444443313431          ";
"                           11133442222244424433431          ";
"                              11113442222224433411          ";
"                                 1113334422433333           ";
"                                    1111334233341           ";
"                                       1113343341           ";
"                                          1144241           ";
"                                           133431           ";
"                                           111311           " |]

let pixdraw =
  GDraw.pixmap ~window ~width:60 ~height:40 ~mask:true ()
let pixdraw1 =
  GDraw.pixmap_from_xpm_d ~data:kitten ~window:window ()
let pixdraw2 =
  GDraw.pixmap_from_xpm_d ~data:pillow ~window:window ()

(* The cell class: a button with a pixmap on it *)

class cell ?packing ?show () =
  let button = GButton.button ?packing ?show () in
object (self)
  inherit GObj.widget button#as_widget
  method connect = button#connect
  val mutable color : color = `none
  val pm = GMisc.pixmap pixdraw ~packing:button#add ()
  method color = color
  method set_color col =
    if col <> color then begin
      color <- col;
      pm#set_pixmap
	(match col with `none -> pixdraw
	| `black -> pixdraw1
	| `white -> pixdraw2)
    end
end

module RealBoard = Board (
  struct
    type t = cell array array
    let size = 10
    let get (board : t) ~x ~y = board.(x).(y)#color
    let set (board : t) ~x ~y ~color = board.(x).(y)#set_color color
  end
)

(* Conducting a game *)

let rec iterate0 f n m l =
  if n <= m then iterate0 f (n+1) m (f n::l)
  else l

let iterate f n m =
  iterate0 f n m []

open RealBoard

class game ~(frame : #GContainer.container) ~(label : #GMisc.label)
    ~(statusbar : #GMisc.statusbar) =
  let buttons = GPack.table ~columns:(2*size) ~rows:size ~packing:frame#add ~homogeneous:false
 () in
object (self)
  val cells =
    Array.init size
      ~f:(fun j -> Array.init size
	  ~f:(fun i -> new cell ~packing:(buttons#attach ~top:i ~left:(2*j+i mod 2) ~right:(2*j+i mod 2+2)) ()))
  val mutable kx = size/2
  val mutable ky = size/2
  val label = label
  val messages = statusbar#new_context ~name:"messages"
  method board = cells
  method table = buttons
  val mutable game_over = false

  method finish () =
    game_over <- true;
    messages#pop ();
    messages#push
      (if on_board kx ky then "Kitten is safe"
       else "Kitten has escaped");
    ()

  method play x y =
    if not game_over then
      if add_pillow cells ~x ~y then begin
        match kitty cells kx ky with
          | [] ->
            self#finish ();
          | [(tx,ty)] ->
            move cells kx ky tx ty;
            kx <- tx;
            ky <- ty;
            if not (on_board kx ky) then
              self#finish ();
      end else
        messages#flash "You cannot play there"

  initializer
    for i = 0 to size-1 do for j = 0 to size-1 do
      let cell = cells.(i).(j) in
      cell#connect#enter ~callback:cell#misc#grab_focus;
      cell#connect#clicked ~callback:(fun () -> self#play i j)
    done done;
    (* Random.self_init didn't work on my machine *)
    Random.init (truncate (Unix.time ()));
    let count = (size + Random.int size) / 2 in
    let pillows = iterate (fun(_) -> (Random.int size, Random.int size)) 1 count in
    List.iter ~f:(fun (x,y,col) -> cells.(x).(y)#set_color col)
      (append (map (fun (x,y) -> (x,y,`white)) pillows) [kx,ky,`black]);
    ()
end

(* Graphical elements *)

let vbox = GPack.vbox ~packing:window#add ()
let frame = GBin.frame ~shadow_type:`IN ~packing:vbox#add ()
let hbox = GPack.hbox ~packing:vbox#pack ()

let bar = GMisc.statusbar ~packing:hbox#add ()

let frame2 = GBin.frame ~shadow_type:`IN ~packing:hbox#pack ()
let label =
  GMisc.label ~justify:`LEFT ~xpad:5 ~xalign:0.0 ~packing:frame2#add ()

let game = new game ~frame ~label ~statusbar:bar

(* Start *)

let _ =
  window#connect#destroy ~callback:Main.quit;
  window#show ();
  Main.main ()

